home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / LANG / PROLOG / BP330 / !BinPro330 / progs / lconstr < prev    next >
Text File  |  1995-01-30  |  3KB  |  113 lines
  1. % Program: linear implication based FD constraint solving
  2. % Author: Paul Tarau, 1995
  3.  
  4. % simple cryptarithmetic puzzle solver
  5. % a kind of "constraint solving with linear implication"
  6.  
  7. example1(
  8.    [s,e,n,d,m,o,r,e,y]=[S,E,N,D,M,O,R,E,Y],
  9.    [S,E,N,D]+
  10.    [M,O,R,E]=
  11.  [M,O,N,E,Y],
  12.    [s,e,n,d]+
  13.    [m,o,r,e]=
  14. [ m,o,n,e,y]
  15. ).
  16.  
  17. % example from wamcc(clp)  - adapted by 
  18. % Daniel Diaz - INRIA France, Original Source: P. Van Hentenryck's book                                       
  19. example2(
  20.    [a,b,c,d,e,f,g,h,i,j]=[A,B,C,D,E,F,G,H,I,J],
  21.    [B, A, I, J, J, A, J, I, I, A, H, F, C, F, E, B, B, J, E, A]+
  22.    [D, H, F, G, A, B, C, D, I, D, B, I, F, F, A, G, F, E, J, E]=
  23.    [G, J, E, G, A, C, D, D, H, F, A, F, J, B, F, I, H, E, E, F],
  24.  
  25.    [b, a, i, j, j, a, j, i, i, a, h, f, c, f, e, b, b, j, e, a]+
  26.    [d, h, f, g, a, b, c, d, i, d, b, i, f, f, a, g, f, e, j, e]=
  27.    [g, j, e, g, a, c, d, d, h, f, a, f, j, b, f, i, h, e, e, f]
  28. ).
  29.  
  30. % Addition of two numbers
  31. sum(As, Bs, Cs) :- sum(As, Bs, 0, Cs).
  32.  
  33. sum([A|As], [B|Bs], Carry, [C|Cs]) :- !,
  34.     add2digits(A,B,Carry,C,NewCarry),
  35.         sum(As, Bs, NewCarry, Cs).
  36. sum([], Bs, 0, Bs) :- !.
  37. sum(As, [], 0, As) :- !.
  38. sum([], [B|Bs], Carry, [C|Cs]) :- !,
  39.     add1digit(B,Carry,C,NewCarry),
  40.         sum([], Bs, NewCarry, Cs).
  41. sum([A|As], [], Carry, [C|Cs]) :- !,
  42.     add1digit(A,Carry,C,NewCarry),
  43.         sum([], As, NewCarry, Cs).
  44. sum([], [], Carry, [Carry]).
  45.  
  46. add2digits(A,B,Carry,Result,NewCarry):-
  47.   bind(A),bind(B),
  48.   add_with_carry(10,A,B,Carry,Result,NewCarry).
  49.  
  50. add1digit(D,Carry,Result,NewCarry):-
  51.   bind(D),
  52.   add_with_carry(10,D,0,Carry,Result,NewCarry).
  53.  
  54. add_with_carry(Base,A,B,Carry,Result,NewCarry):-
  55.   S is A+B+Carry,
  56.   Result is S mod Base,
  57.   NewCarry is S // Base,
  58.   new_digit(Result).
  59.  
  60. reverse(Xs,Zs):-rev(Xs,[],Zs).
  61.  
  62. rev([],Ys,Ys).
  63. rev([X|Xs],Ys,Zs):-rev(Xs,[X|Ys],Zs).
  64.  
  65. bind(A):-var(A),!,digit(A).
  66. bind(_).
  67.  
  68. new_digit(A):-digit(A),!.
  69. new_digit(_).
  70.  
  71. solve(As,Bs,Cs,Z):-
  72.   digit(0)-:digit(1)-:digit(2)-:digit(3)-:digit(4)-:digit(5)-:
  73.   digit(6)-:digit(7)-:digit(8)-:digit(9)-:
  74.   ( sum(As,Bs,Cs),
  75.     Z>0
  76.   ).
  77.  
  78. show_answer(Vars,Ns+Vs=Rs,As+Bs=Cs):-
  79.   write(Vars),nl,nl,
  80.   write(As),write(+),nl,
  81.   write(Bs),write(=),nl,
  82.   write(Cs),nl,nl,
  83.   write(Ns),write(+),nl,
  84.   write(Vs),write(=),nl,
  85.   write(Rs),nl,nl.
  86.  
  87. puzzle:-
  88.     init(Vars,Puzzle,Names),
  89.     Puzzle=(Xs+Ys=Zs),Zs=[Z|_],
  90.     reverse(Xs,As),
  91.     reverse(Ys,Bs),
  92.     reverse(Zs,Cs),
  93.       solve(As,Bs,Cs,Z),
  94.       show_answer(Vars,Names,Puzzle),
  95.     fail.
  96. puzzle:-
  97.     write('no (more) answers'),nl,nl.
  98.  
  99. time(Goal):-
  100.   ctime(T1),
  101.   (Goal->true;true),
  102.   ctime(T2),
  103.   T is T2-T1,
  104.   write(time=T),nl,nl.
  105.   
  106. go:-
  107.   (init(X,Y,Z):-example1(X,Y,Z))-:
  108.   time(puzzle),
  109.   fail.
  110. go:-
  111.   (init(X,Y,Z):-example2(X,Y,Z))-:
  112.   time(puzzle).
  113.